home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / tsmtp11 / mime.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  12KB  |  544 lines
  1. unit Mime;
  2.  
  3. interface
  4.  
  5. uses Classes,SysUtils,Forms,Dialogs;
  6.  
  7. const
  8.   MaxChars = 57;
  9.  
  10. type
  11.   TBinBytes = array[1..MaxChars] of byte;
  12.   TTxtBytes = array[1..2*MaxChars] of byte;
  13.   T24Bits = array[0..8*MaxChars] of boolean;
  14.  
  15. EUUInvalidCharacter = class(Exception)
  16.   constructor Create;
  17. end;
  18.  
  19.  EMIMEError = class(Exception);
  20.  
  21. {$IFDEF UseHuge}
  22. TTextStream = class(TMemoryStream)
  23. public
  24.   procedure Write(const s : string);
  25.   procedure Read(var s : string);
  26. end;
  27. {$ENDIF}
  28.  
  29.   TBase64 = class
  30.   private
  31. {$IFDEF UseHuge}
  32.     TextStream : TTextStream;
  33. {$ELSE}
  34.     TextStream : TStringList;
  35. {$ENDIF}
  36.     Stream : TStream;
  37.     CurSection : byte;
  38.     A24Bits : T24Bits;
  39.     FOnProgress : TNotifyEvent;
  40.     FOnStart : TNotifyEvent;
  41.     FOnEnd : TNotifyEvent;
  42.     function GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  43.     procedure GenerateBinBytes(InS : string; BufPtr : pointer;
  44.                                var BytesGenerated : word);
  45.     function ByteFromTable(Ch : Char) : byte;
  46.     procedure DoProgress(Sender : TObject);
  47.     procedure DoStart(Sender : TObject);
  48.     procedure DoEnd(Sender : TObject);
  49.   public
  50.     Progress : Integer;
  51.     ProgressStep : Integer;
  52.     Canceled : boolean;
  53.     Table : string;
  54. {$IFDEF UseHuge}
  55.     constructor Create(AStream : TStream; ATextStream : TTextStream);
  56. {$ELSE}
  57.     constructor Create(AStream : TStream; ATextStream : TStringList);
  58. {$ENDIF}
  59.     procedure Encode;
  60.     procedure Decode;
  61.     property OnProgress : TNotifyEvent read FOnProgress
  62.                              write FOnProgress;
  63.     property OnStart : TNotifyEvent read FOnStart write FOnStart;
  64.     property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
  65.   end;
  66.  
  67.   TQuotedPrintable = class(TComponent)
  68.   private
  69.     { Private declarations }
  70.   protected
  71.     { Protected declarations }
  72.     Stream : TStream;
  73.     Lines : TStringList;
  74.     procedure ReplaceHiChars(var s : string);
  75.     procedure ReplaceHex(var s : string);
  76.     procedure ReformatParagraph(Buf : PChar; Len : Integer;
  77.                TL : TStringList);
  78.   public
  79.     { Public declarations }
  80.     Canceled : boolean;
  81.     constructor Create(AStream : TStream; ALines : TStringList);
  82.     procedure Encode;
  83.     procedure Decode;
  84.   published
  85.     { Published declarations }
  86.   end;
  87.  
  88. function GetContentType(const FileName : string) : string;
  89. function MakeUniqueID : string;
  90.  
  91. implementation
  92.  
  93. constructor EUUInvalidCharacter.Create;
  94. begin
  95.   inherited Create('Invalid character in the input file');
  96. end;
  97.  
  98. {$IFDEF UseHuge}
  99. {TTextStream}
  100. procedure TTextStream.Write(const s : string);
  101. var
  102.   Buf : array[0..255] of Char;
  103.   sLen : byte absolute s;
  104. begin
  105.   StrPCopy(@Buf,Concat(s,^M^J));
  106.   inherited Write(Buf,StrLen(@Buf));
  107. end;
  108.  
  109. procedure TTextStream.Read(var s : string);
  110. var
  111.   sLen : byte absolute s;
  112.   Ch : Char;
  113. begin
  114.   Ch:=#00; s:='';
  115.   repeat
  116.     inherited Read(Ch,1);
  117.     if not (Ch in [^M,^J]) then
  118.       s:=Concat(s,Ch);
  119.   until Ch=^J;
  120. end;
  121. {$ENDIF}
  122.  
  123. {implementation for TBase64}
  124. {$IFDEF UseHuge}
  125. constructor TBase64.Create(AStream : TStream; ATextStream : TTextStream);
  126. {$ELSE}
  127. constructor TBase64.Create(AStream : TStream; ATextStream : TStringList);
  128. {$ENDIF}
  129. begin
  130.   inherited Create;
  131.   Stream:=AStream;
  132.   TextStream:=ATextStream;
  133.   ProgressStep:=10;
  134.   Table:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  135.   FillChar(A24Bits,SizeOf(A24Bits),0);
  136. end;
  137.  
  138. procedure TBase64.DoProgress(Sender : TObject);
  139. begin
  140.   if Assigned(FOnProgress) then
  141.     FOnProgress(Sender);
  142. end;
  143.  
  144. procedure TBase64.DoStart(Sender : TObject);
  145. begin
  146.   if Assigned(FOnStart) then
  147.     FOnStart(Sender);
  148. end;
  149.  
  150. procedure TBase64.DoEnd(Sender : TObject);
  151. begin
  152.   if Assigned(FOnEnd) then
  153.     FOnEnd(Sender);
  154. end;
  155.  
  156. function TBase64.GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
  157. var
  158.   i,j,k,b,m : word;
  159.   s : string;
  160. begin
  161.   k:=0;
  162.   FillChar(A24Bits,SizeOf(T24Bits),0);
  163.   for i:=1 to MaxChars do
  164.   begin
  165.     b:=tb[i];
  166.     for j:=7 DownTo 0 do
  167.     begin
  168.       m:=1 shl j;
  169.       if (b and m = m) then
  170.         A24Bits[k]:=true;
  171.       Inc(k);
  172.     end;
  173.   end;
  174.   s:=''; k:=0; m:=4*(MaxChars div 3);
  175.   for i:=1 to m do
  176.   begin
  177.     b:=0;
  178.     for j:=5 DownTo 0 do
  179.     begin
  180.       if A24Bits[k] then b:= b or (1 shl j);
  181.       Inc(k);
  182.     end;
  183.     s[i]:=Table[b+1];
  184.   end;
  185.   if (NumOfBytes=MaxChars) or (NumOfBytes mod 3=0) then
  186.      s[0]:=Char(4*NumOfBytes div 3)
  187.   else
  188.   begin
  189.     s[0]:=Char(4*NumOfBytes div 3+1);
  190.     while (Length(s) mod 4)<>0 do
  191.       s:=Concat(s,'=');
  192.   end;
  193.   Result:=s;
  194. end;
  195.  
  196. procedure TBase64.Encode;
  197. var
  198.   BytesRead : word;
  199.   ABinBytes : TBinBytes;
  200.   Total : LongInt;
  201. begin
  202.   DoStart(Self);
  203.   TextStream.Clear;
  204.   Progress:=0; Total:=0; Canceled:=false;
  205.   try
  206.     repeat
  207.       FillChar(ABinBytes,SizeOf(TBinBytes),0);
  208.       BytesRead:=Stream.Read(ABinBytes,MaxChars);
  209.       Inc(Total,BytesRead);
  210. {$IFDEF UseHuge}
  211.       TextStream.Write(GenerateTxtBytes(ABinBytes,BytesRead));
  212. {$ELSE}
  213.       TextStream.Add(GenerateTxtBytes(ABinBytes,BytesRead));
  214. {$ENDIF}
  215.       Progress:=Round(100*Total/Stream.Size);
  216.       if Progress mod ProgressStep = 0 then
  217.          DoProgress(Self);
  218.       Application.ProcessMessages;
  219.     until (BytesRead<MaxChars) or Canceled;
  220.   finally
  221.     Progress:=100;
  222.     DoProgress(Self);
  223.     if Canceled then TextStream.Clear;
  224.     DoEnd(Self);
  225.   end;
  226. end;
  227.  
  228. function TBase64.ByteFromTable(Ch : Char) : byte;
  229. var
  230.   i : byte;
  231. begin
  232.   i:=1;
  233.   while (Ch<>Table[i]) and (i<=64) do Inc(i);
  234.   if i>64 then
  235.   begin
  236.     if Ch='=' then Result:=0
  237.       else raise EUUInvalidCharacter.Create;
  238.   end;
  239.   Result:=i-1;
  240. end;
  241.  
  242. procedure TBase64.GenerateBinBytes(InS : string; BufPtr : pointer;
  243.                           var BytesGenerated : word);
  244. var
  245.   i,j,k,b,m : word;
  246.   InSLen : byte absolute InS;
  247.   ActualLen : byte;
  248. begin
  249.   FillChar(BufPtr^,MaxChars,0);
  250.   FillChar(A24Bits,SizeOf(T24Bits),0);
  251.   k:=0;
  252.   for i:=1 to InSLen do
  253.   begin
  254.     b:=ByteFromTable(InS[i]);
  255.     for j:=5 DownTo 0 do
  256.     begin
  257.       m:=1 shl j;
  258.       if (b and m = m) then
  259.         A24Bits[k]:=true;
  260.       Inc(k);
  261.     end;
  262.   end;
  263.   k:=0;
  264.   if InSLen<>4*MaxChars div 3 then
  265.   begin
  266.     ActualLen:=3*InSLen div 4;
  267.     while InS[InSLen]='=' do
  268.     begin
  269.       Dec(ActualLen);
  270.       Dec(InSLen);
  271.     end;
  272.   end
  273.   else
  274.     ActualLen:=MaxChars;
  275.   for i:=1 to ActualLen do
  276.   begin
  277.     b:=0;
  278.     for j:=7 DownTo 0 do
  279.     begin
  280.       if A24Bits[k] then b:= b or (1 shl j);
  281.       Inc(k);
  282.     end;
  283.     byte(PChar((PChar(BufPtr)+i-1))^):=b;
  284.   end;
  285.   BytesGenerated:=i;
  286. end;
  287.  
  288. procedure TBase64.Decode;
  289. var
  290.   ATxtBytes : TTxtBytes;
  291.   BytesGenerated : word;
  292.   Total : LongInt;
  293.   s : string;
  294.   p : pointer;
  295. {$IFNDEF UseHuge}
  296.   i : LongInt;
  297. {$ENDIF}
  298. begin
  299.   DoStart(Self);
  300.   Progress:=0;
  301.   Canceled:=false;
  302. {$IFNDEF UseHuge}
  303.   i:=0;
  304. {$ENDIF}
  305.   try
  306.     GetMem(p,MaxChars);
  307.     Total:=0;
  308.     repeat
  309.       FillChar(p^,MaxChars,0);
  310. {$IFDEF UseHuge}
  311.       TextStream.Read(s);
  312. {$ELSE}
  313.       s:=TextStream[i];
  314. {$ENDIF}
  315.       GenerateBinBytes(s,p,BytesGenerated);
  316.       Stream.Write(p^,BytesGenerated);
  317.       Inc(Total,BytesGenerated);
  318. {$IFDEF UseHuge}
  319.       Progress:=Round(100*Total/TextStream.Size);
  320. {$ELSE}
  321.       Progress:=Round(100*i/(TextStream.Count-1));
  322. {$ENDIF}
  323.       if Progress mod ProgressStep = 0 then
  324.          DoProgress(Self);
  325.       Application.ProcessMessages;
  326. {$IFDEF UseHuge}
  327.     until (TextStream.Position>=TextStream.Size) or Canceled;
  328. {$ELSE}
  329.       Inc(i);
  330.     until (i>=TextStream.Count);
  331. {$ENDIF}
  332.   finally
  333.     Progress:=100;
  334.     DoProgress(Self);
  335.     FreeMem(p,MaxChars);
  336.     DoEnd(Self);
  337.   end;
  338. end;
  339.  
  340. {implementation for TQuotedPrintable}
  341.  
  342. const
  343.   BufSize=$6000;
  344.  
  345. constructor TQuotedPrintable.Create(AStream : TStream; ALines : TStringList);
  346. begin
  347.   Stream:=AStream;
  348.   Lines:=ALines;
  349.   Canceled:=false;
  350. end;
  351.  
  352. procedure TQuotedPrintable.ReplaceHiChars(var s : string);
  353. var
  354.   sLen : byte absolute s;
  355.   i : byte;
  356. begin
  357.   i:=1;
  358.   while i<sLen do
  359.   begin
  360.     if Ord(s[i]) in [0..31,61,